home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / textFill.tcl < prev    next >
Encoding:
Text File  |  1998-11-21  |  13.6 KB  |  468 lines  |  [TEXT/ALFA]
  1. ####################################################################
  2. # 
  3. # Much by Vince Darley.
  4. # 
  5. #                                    created: 26/11/96 {7:08:34 pm} 
  6. #                                last update: 16/5/96 
  7. #  Author: Vince Darley
  8. #  E-mail: <mailto:vince@das.harvard.edu>
  9. #    mail: Division of Applied Sciences, Harvard University
  10. #          Oxford Street, Cambridge MA 02138, USA
  11. #     www: <http://www.fas.harvard.edu/~darley/>
  12. #  
  13. ####################################################################
  14.  
  15. ## 
  16.  # Here's a    brief explanation of the smart fillParagraph routines
  17.  # 
  18.  # 'fillParagraph'
  19.  #       If there's a    selection, then    fill all paragraphs    in that
  20.  #       selection. If not then fill the paragraph surrounding the
  21.  #       insertion point.    The    definition of a    'paragraph'    may    be
  22.  #       mode    dependent (see paraStart, paraFinish)
  23.  #       
  24.  # 'fillOneParagraph'
  25.  #       Fills the single    paragraph surrounding the insertion    point.
  26.  #       If called with parameter    '0', it    doesn't    bother to remember
  27.  #       where the insertion point was, which    makes multiple paragraph
  28.  #       fills quicker when called by    'fillParagraph'
  29.  #       
  30.  # 'rememberWhereYouAre'
  31.  #       Given the start of a    paragraph and the point    to remember,
  32.  #       this    creates    a record stored    in '__g_remember_pos' so that
  33.  #       the following function can find that    spot later,    even after
  34.  #       the paragraph has had space/tabs/new-lines meddled with.
  35.  #       
  36.  # 'goBackToWhereYouWere'
  37.  #       Given the beginning and end of a    selection, where the beginning
  38.  #       corresponds to a    previous call of 'rememberWhereYouAre',    this
  39.  #       procedure will move the insertion point to the correct place.
  40.  #       
  41.  # 'texParaCommands'
  42.  #       A variable containing the bulk of a regexp for paragraph
  43.  #       indicators in 'TeX' mode.
  44.  #       
  45.  # 'paraStart'
  46.  #       Finds the start of the paragraph    containing the insertion point.
  47.  #       
  48.  # 'paraFinish'
  49.  #       Finds the end of    the    paragraph containing the insertion point.
  50.  ##
  51.     
  52. proc fillParagraph {} {
  53.     if {[pos::compare [getPos] == [selEnd]]} {
  54.     fillOneParagraph
  55.     } else {    
  56.     set start [getPos]
  57.     set end [selEnd]
  58.     set p $start
  59.     while {[pos::compare $p < $end] && [pos::compare $p < [maxPos]]} {
  60.         goto $p
  61.         set p [fillOneParagraph 0]
  62.     }
  63.     goto $start
  64.     }
  65. }
  66.  
  67. proc rememberWhereYouAre { startPara pos } {
  68.     global __g_remember_str
  69.     if {[pos::compare [pos::math $pos - 20] < $startPara]} {
  70.     set srem $startPara
  71.     } else {
  72.     set srem [pos::math $pos - 20]
  73.     }
  74.     set __g_remember_str [quote::Regfind [getText $srem $pos]]
  75.     regsub -all "\[ \t\r\n\]+" $__g_remember_str {[ \t\r\n]+} __g_remember_str
  76. }
  77.  
  78. proc goBackToWhereYouWere { start end } {
  79.     global __g_remember_str
  80.     if { $__g_remember_str != "" } {
  81.     regexp -indices ".*(${__g_remember_str}).*" [getText $start $end] "" submatch
  82.     set p [expr {[info exists submatch] ? \
  83.       [pos::math $start + [expr {1 + [lindex $submatch 1]}]] : $end}]
  84.     goto [expr {[pos::compare $p >= $end] ? [pos::math $end - 1] : $p}]
  85.     } else {
  86.     goto $start
  87.     }
  88. }
  89.  
  90. ## 
  91.  # -------------------------------------------------------------------------
  92.  #     
  93.  #    "getLeadingIndent" --
  94.  #    
  95.  #     Find the indentation of the line containing 'pos',    and    convert    it
  96.  #     to    a minimal form of tabs followed    by spaces.    If 'size'
  97.  #     is    given, then    the    variable of    that name is set to    the    length of
  98.  #     the indent. Similarly 'halftab' can be set to half a tab.
  99.  # -------------------------------------------------------------------------
  100.  ##
  101. proc getLeadingIndent { pos {size ""} {halftab ""} } {
  102.     # get the leading whitespace of the current line
  103.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  104.     
  105.     # convert it to minimal form: tabs then spaces, stored in 'front'
  106.     getWinInfo a
  107.     set sp [string range "              " 1 $a(tabsize) ]
  108.     regsub -all "($sp| +\t)" [eval getText $res] "\t" front
  109.     if { $size != "" } {
  110.     upvar $size ind
  111.     # get the length of the indent
  112.     regsub -all "\t" $front $sp lfront
  113.     set ind [string length $lfront]
  114.     }
  115.     if { $halftab != "" } {
  116.     upvar $halftab ht
  117.     # get the length of half a tab
  118.     set ht [string range "            " 1 [expr {$a(tabsize)/2}]]
  119.     }
  120.     
  121.     return $front
  122. }
  123.  
  124. ## 
  125.  # -------------------------------------------------------------------------
  126.  # 
  127.  # "fillOneParagraph" --
  128.  # 
  129.  #  Fixes: won't put a double-space after abbreviations like 'e.g.', 'i.e.'
  130.  #  
  131.  #  Works around the Alpha 'replaceText' bug.
  132.  # -------------------------------------------------------------------------
  133.  ##
  134. proc fillOneParagraph {{remember 1}} {
  135.     global leftFillColumn fillColumn doubleSpaces
  136.  
  137.     set pos [getPos]
  138.     
  139.     set start [paraStart $pos] 
  140.     set end [paraFinish $pos]
  141.     if {$remember} { rememberWhereYouAre $start $pos }
  142.     
  143.     # Get the leading whitespace of the current line and store length in 'left'
  144.     set front [getLeadingIndent $pos left]
  145.     # fill the text
  146.     regsub -all "\[ \t\r\n\]+" [string trim [getText $start $end]] " " text
  147.     # turn single spaces at end of sentences into double
  148.     if {$doubleSpaces} {regsub -all {(([^.][a-z]|[^a-zA-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  149.     #     if {$doubleSpaces} {regsub -all {(([^A-Z@]|\\@)[.?!][])'"]?) } $text {\1  } text}
  150.  
  151.     # temporarily adjust the fillColumns
  152.     set ol $leftFillColumn
  153.     set or $fillColumn
  154.     set leftFillColumn 0
  155.     set fillColumn [expr {$fillColumn - $left}]
  156.         
  157.     # break and indent the paragraph
  158.     regsub -all "\r" "\r[string trimright [breakIntoLines $text]]" "\r${front}" text
  159.     # reset columns
  160.     set leftFillColumn $ol
  161.     set fillColumn  $or
  162.     
  163.     # don't replace if nothing's changed
  164.     if { "$text\r" != "\r[getText $start $end]" } {
  165.     # workaround an alpha bug
  166.     if {$remember} { 
  167.         getWinInfo a
  168.         if {[pos::compare [rowColToPos $a(currline) 0] > $start]} { goto $start }
  169.     }
  170.     replaceText $start $end "[string range $text 1 end]\r"
  171.     if {$remember} {
  172.         goBackToWhereYouWere $start [pos::math $start + [string length $text]] 
  173.     }
  174.     }
  175.     
  176.     # in case we wish to fill a region
  177.     return $end
  178. }
  179.  
  180.  
  181. ## 
  182.  # -------------------------------------------------------------------------
  183.  # 
  184.  #    "paraStart"    -- "paraFinish"
  185.  # 
  186.  #     Newly simplified version with fewer regexp    '()' pairs.    Also I think
  187.  #     it    deals better with TeX comments than    the    old    regexp.
  188.  #     
  189.  #     "Start": It's pretty clear    for    non    TeX    modes how this works.  The only    
  190.  #     key is    that we    start at the beginning of the current line and look    back.  
  191.  #     We    then have a    quick check    for    whether    we found that very beginning (in 
  192.  #     which case    return it) or if not (in which case we have found the end of 
  193.  #     the previous paragraph) we move forward a line.
  194.  # 
  195.  #     "Finish": The only    addition is    the    need for an    additional check for
  196.  #     stuff which explicitly    ends lines.
  197.  #       
  198.  #    Results:
  199.  #     The start/finish position of the paragraph containing the given 'pos'
  200.  # 
  201.  # --Version--Author------------------Changes-------------------------------
  202.  #      1.1      <darley@fas.harvard.edu> Cut down on '()' pairs
  203.  #    1.2     Vince - March '96          Better filling for TeX tables ('hline')
  204.  #    1.3     Johan Linde - May '96   Now sensitive to HTML elements
  205.  #    1.4     <darley@fas.harvard.edu> Handle Tcl lists, top of file fix.
  206.  # -------------------------------------------------------------------------
  207.  ##
  208. proc paraStart {pos} {
  209.     global mode 
  210.     global ${mode}::startPara
  211.     if {[pos::compare $pos == [maxPos]]} {set pos [pos::math $pos - 1]}
  212.     set pos [lineStart $pos]
  213.     if {[info exists ${mode}::startPara]} {
  214.     set startPara [set ${mode}::startPara]
  215.     } else {
  216.     switch -- $mode {
  217.         "TeX" -
  218.         "Bib" {
  219.         global texParaCommands
  220.         set startPara {^[ \t]*$|\\\\[ \t]*$|(^|[^\\])%|\\h+line[ \t]*$|\$\$[ \t]*$|^[ \t]*(\\(}
  221.         append startPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  222.         } 
  223.         "HTML" {
  224.         global htmlParaCommands
  225.         set startPara {^[ \t]*$|</?(}
  226.         append startPara $htmlParaCommands {)([ \t\r]+[^>]*>|>)}
  227.         }
  228.         default {
  229.         set startPara {^([ \t]*|([\\%].*))$}
  230.         }
  231.     }
  232.     }
  233.  
  234.     set res [search -s -n -f 0 -r 1 -l [minPos] -- "$startPara" $pos]
  235.     if {![string length $res] || $res == "0 0" } {
  236.     # bug work-around.  Alpha fails to match '^' with start of file.
  237.     return [lineStart [lindex [search -s -f 1 -r 1 "\[^ \t\r\n\]" [minPos]] 0]]
  238.     } elseif { [lindex $res 0] == $pos } {
  239.     return $pos
  240.     } else {
  241.     return [nextLineStart [lindex $res 0]]
  242.     }
  243.     
  244. }
  245.  
  246. proc paraFinish {pos} {
  247.     global mode
  248.     global ${mode}::endPara
  249.     set pos [lineStart $pos]
  250.     set end [maxPos]
  251.     if {[info exists ${mode}::endPara]} {
  252.     set endPara [set ${mode}::endPara]
  253.     } else {
  254.     switch -- $mode {
  255.         "TeX" -
  256.         "Bib" {
  257.         global texParaCommands
  258.         set endPara {^[ \t]*$|(^|[^\\])%|\$\$[ \t]*$|^[ \t]*(\\(}
  259.         append endPara $texParaCommands {)(\[.*\]|\{.*\}|•)*[ \t]*)+$}
  260.         } 
  261.         "HTML" {
  262.         global htmlParaCommands
  263.         set endPara {^[ \t]*$|</?(}
  264.         append endPara $htmlParaCommands {)([ \t\r\n]+[^>]*>|>)}
  265.         }
  266.         default {
  267.         set endPara {^([ \t]*|([\\%].*))$}
  268.         }
  269.     }
  270.     }
  271.     
  272.     set res [search -s -n -f 1 -r 1 -l $end -- "$endPara" $pos]
  273.     if {![string length $res]} {return $end}
  274.     set cpos [lineStart [lindex $res 0] ]
  275.     if {[pos::compare $cpos == $pos]} {
  276.     return [nextLineStart $cpos]
  277.     }
  278.     # A line which ends in '\\', '%...', '\hline', '\hhline'
  279.     # signifies the end of the current paragraph in TeX mode
  280.     # (the above checked for beginning of the next paragraph).
  281.     if { $mode == "TeX" || $mode == "Bib" } {
  282.     set res2 [search -s -n -f 1 -r 1 -l $end {((\\\\|\\h+line)[ \t]*|[^\\]%.*)$} $pos]
  283.     if {[string length $res2]} {
  284.         if {[pos::compare [lindex $res2 0] < $cpos] } {
  285.         return [nextLineStart [lindex $res2 0]]
  286.         }
  287.     }
  288.     }
  289.  
  290.     return $cpos
  291.     
  292. }
  293.  
  294. proc selectParagraph {} {
  295.     set pos [getPos]
  296.     set start [paraStart $pos] 
  297.     set finish [paraFinish $pos]
  298.     goto $start
  299.     select $start $finish
  300. }
  301.  
  302. proc sentenceParagraph {} {
  303.     set pos [getPos]
  304.     set start [paraStart $pos] 
  305.     set finish [paraFinish $pos]
  306.  
  307.     set t [string trim [getText $start $finish]]
  308.     set period [regexp {\.$} $t]
  309.     regsub -all "\[ \t\r\]+" $t " " text
  310.     regsub -all {\. } $text "Δ" text
  311.     set result ""
  312.     foreach line [split [string trimright $text {.}] "Δ"] {
  313.         if {[string length $line]} {
  314.             append result [breakIntoLines $line] ".\r"
  315.         }
  316.     }
  317.     if {!$period && [regexp {\.\r} $result]} {
  318.         set result [string trimright $result ".\r"]
  319.         append result "\r"
  320.     }
  321.     if {$result != [getText $start $finish]} {
  322.         replaceText $start $finish $result
  323.     }
  324.     goto $pos
  325. }
  326.  
  327. proc getEndpts {} {
  328.     if {[pos::compare [getPos] == [selEnd]]} {
  329.     set start [getPos]
  330.     set finish [getMark]
  331.     if {[pos::compare $start > $finish]} {
  332.         set temp $start
  333.         set start $finish
  334.         set finish $temp
  335.     }
  336.     } else {
  337.     set start [getPos]
  338.     set finish [selEnd]
  339.     }
  340.     return [list $start $finish]
  341. }
  342.  
  343.  
  344. proc fillRegion {} {
  345.     global leftFillColumn
  346.     set ends [getEndpts]
  347.     set start [lineStart [lindex $ends 0]]
  348.     set finish [lindex $ends 1]
  349.     goto $start
  350.     set text [fillText $start $finish]
  351.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  352. }
  353.     
  354. proc wrapParagraph {} {
  355.     set pos [getPos]
  356.     set start [paraStart $pos] 
  357.     set finish [paraFinish $pos]
  358.     goto $start
  359.     wrapText $start $finish
  360.     goto $pos
  361. }
  362.  
  363. proc wrapRegion {} {
  364.     set ends [getEndpts]
  365.     set start [lineStart [lindex $ends 0]]
  366.     set finish [lindex $ends 1]
  367.     if {[pos::compare $start == $finish]} {
  368.     set finish [maxPos]
  369.     }
  370.     wrapText $start $finish
  371. }
  372.     
  373.  
  374.  
  375. # Remove text from window, transform, and insert back into window.
  376. proc fillText {from to} {
  377.     global doubleSpaces
  378.     set text [getText $from $to]
  379.     regexp {^ *} $text front
  380.     set text [string trim $text]
  381.     regsub -all "\[ \t\n\r\]+" $text " " text
  382.     if {$doubleSpaces} {regsub -all {(\.|\?|\!) } $text {\1  } text}
  383.     regsub -all "\[\r\n\]" [string trimright [breakIntoLines $text]] "\r${front}" text
  384.     return $front$text
  385. }
  386.  
  387. proc paragraphToLine {} {
  388.     global fillColumn
  389.     global leftFillColumn
  390.     set fc $fillColumn
  391.     set lc $leftFillColumn
  392.     set fillColumn 10000
  393.     set leftFillColumn 0
  394.     fillRegion
  395.     set fillColumn $fc
  396.     set leftFillColumn $lc
  397. }
  398.  
  399. proc lineToParagraph {} {
  400.     global fillColumn
  401.     global leftFillColumn
  402.     set fc $fillColumn
  403.     set fillColumn 75
  404.     set lc $leftFillColumn
  405.     set leftFillColumn 0
  406.     fillRegion
  407.     set fillColumn $fc
  408.     set leftFillColumn $lc
  409. }
  410.  
  411.  
  412. #set sentEnd {[.!?](\r|\n| +)}
  413. set sentEnd {(\r\r|\n\n|[.!?](\r|\n| +))}
  414. set sentBeg {[\r\n ][A-Z]}
  415.  
  416. proc nextSentence {} {
  417.     global sentBeg sentEnd
  418.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  419.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  420.         goto [pos::math [lindex $mtch 0] + 1]
  421.     }
  422.     }
  423. }
  424.  
  425.  
  426. proc prevSentence {} {
  427.     global sentBeg sentEnd
  428.     if {[catch {search -s -f 0 -r 1 $sentBeg [pos::math [getPos] - 2]} mtch]} return
  429.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  430.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  431.         goto [pos::math [lindex $mtch 0] + 1]
  432.     }
  433.     }
  434. }
  435.  
  436. #===============================================================================
  437. # Called by Alpha to do "soft wrapping"
  438. proc softProc {pos start next} {
  439.     global leftFillColumn
  440.     goto $start
  441.     set finish [paraFinish $start]
  442.     set text [fillText $start $finish]
  443.     if {"${text}\r" != [getText $start $finish]} {
  444.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  445.     return 1
  446.     } else {
  447.     return 0
  448.     }
  449. }
  450.  
  451. proc dividingLine {} {
  452.     global mode
  453.     global ${mode}modeVars
  454.     if {[info exists ${mode}modeVars(prefixString)]} {
  455.     set a [string trim [set ${mode}modeVars(prefixString)]]
  456.     } else {
  457.     set a "#"
  458.     }
  459.     insertText "${a}===============================================================================\r"
  460. }
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  
  468.